COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	C  THIS PROGRAM IS THE PROPERTY OF LELAND SMITH, PROFESSOR OF MUSIC
C00013 ENDMK
C⊗;
C  THIS PROGRAM IS THE PROPERTY OF LELAND SMITH, PROFESSOR OF MUSIC
C  AT STANFORD UNIVERSITY.  IT MAY NOT BE COPIED OR ALTERED IN ANY
C  WAY WITHOUT WRITTEN PERMISSION OF THE AUTHOR.


C  7/74 **********  SCORE  **********  LELAND SMITH, SEP.1969

C   THIS PROGRAM WRITES NOTE LISTS FOR THE PDP10 SOUND 
C   GENERATION PROGRAM.
C   IF # OF INSTS IS CHANGED, ALSO CHANGE # IN 'INFO'('HELP') FORMAT.
C   LOAD 'S1' WITH S2,S3,SCANR AND SPRINT 
C   (AND QUAD AND QUADO WHEN THEY ARE READY) AND
C   IF DESIRED, A SUBROUTINE WITH THE FOLLOWING HEADING:
C	SUBROUTINE SUBR
C	COMMON /P/P(1) /PL/PL(1) /INS/ INST(27),BG(60)
C	COMMON INUM,IPAR,CNT(27),BT,IREST,DF,DUR(27)
C   INUM=INST#  IPAR=PARAM#  
C   BT=BASIC TIME P1 WHEN SUBROUTINE IS CALLED
C   IF IREST IS <0, THAT NOTE WILL BE A REST.  
C   INST=INST. NAME,  BG=INSTS' BEGIN TIMES.
C   NOTE #S IN SUBROUTINE: (1-108)  C4=49  FS4=55  B4=60  C5=61  ETC.
C   F0=200  F99=299 (LIMIT IS F0-F99!)  'R'(REST)=199

	COMMON /Q/ BNW(200),NWZ /INS/INST(27),BG(60) /TYP/SOS,JOUT,
	1 LN,ITYP,TPALN(4),JED
CC 7/74 COLGATE  COMMON/TYP/ IS FOR COLTTY ROUT.
C  SEE LABEL 1774 AND BELOW RE. BUFFER LIMIT.
	COMMON/VV/LIMIT,V(5000) /A/ROFF(27),NP(27),
	1 RDEV(27),XT(27),OTH(20,16),P1(27),JFM(4),IFM(80)
	1 ,FINM(6),TINST(5),ENFI(5),TEDIT(4),INVIS(27)
	DIMENSION LIST(78),JNP(80)
C   WITH VX,IOUT AT 70 AND IFM AT 80 OK FOR ONLY 
C   40 LIT CHARS + 99 PARAMS PER INST.
C   60 BG TIMES AVAILABLE.  FOR INSTS AND INSERTS AND EDITS.

	COMMON /PCIP/ PCH(27,102),IPT(27,101)
	COMMON/P/P(99) /PL/PL(117) /COPY/NUMP,COPY(99) /COPYL/COPYL(99)
C NUMP=99 = TOTAL NUMBER OF PARAMETERS NOW AVAILABLE. RAN.DEV. IS NUMP+1
	COMMON J,L,CNT(27),BT,MK,DF,DUR(27)
	1/E/IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
	1 ,INP(145),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
	COMMON/B/MOT,PR,T5,NINS,I,RA,KZY,NWX,INONLY,MX,
	1 Y,Z,ISLAC,MZ,N,IDALL,JC,JG,RB,IJ,IX,BW,KB,NL,RC,W,
	1 ZZ,CHN,YY 
	1 /D/TF,AMPFAC,OP1,DURX,IXIN,IFLNM
	1  /C/LPAR,IPRN,QX,RETRO,INVRT,ICON,LCNT,
	1 PARENS,JZ,BY,MLX,IZ,ALL,JD,LEND,QTS,ITMP,
	1 LP,ILIT,NLIT,KTMP,IC,RAX,RD,IA
C  /C/=26
	EQUIVALENCE (LIST,IFM(3)),(JNP,INP)
	DATA KZY/27/,ISEMI/';'/,IQT/'"'/,LIMIT/5000/,NUMP/99/
	1, JFM(3)/','/
C  IAA=A  ID=D  IE=E  IF=F  IEN=N  IPP=P  ISS=S  ITT=T
	DATA IBLA/' '/,IXX/'X'/
	1 ,ISCA/'C','P','D','O','E','F','PLAY;','G','S','A','T','B'/
	1 ,IDAT/'0','1','2','3','4','5','6','7','8','9','.'/
C	1' NOW 99 PARAMETERS MAY BE USED.'/
C	1'     FOR RANDOM RESTS USE RR '/
C	1'         FOR RANDOM P1 DEVIATION USE RD'/)
	LPAR=0
	IPRN=0
	QX=0.
	MOT=0
	RETRO=-1.
	INVRT=-1
	ICON=-1
	LCNT=1
	PARENS=0
      JZ=1  
	CALL RNDINT
C  INIT RAND NUM GENERATOR.
	IAMP=0
C  IAMP IS 'BLANK LINE'FLAG ON PP1-3.
      T5=0  
      NINS=0
	K=0
	IDALL=-1
	QTS=-1.
      KB=0  
      NWZ=1
	BNW(1)=0
	I=1
      KL=0  
CC    TP=0  
      RA=0  
      CHN=0 
	DO 127 K=1,77,3
127	LIST(K)=0
C  INITIALIZES MOTIVIC LIST FOR ERROR FINDING ROUTINE.
	NWX=0
	BY=-1
      DO 1128 K=1,KZY     
	INVIS(K)=0
	INST(K)=0
	CNT(K)=0
	RDEV(K)=0
C  RDEV IS FOR RAND DEVIATIONS AT RUN TIME
	NP(K)=0
	IQ(K)=0
C   IQ IS FOR RESTART FLAG
	IPT(K,1)=0
      DO 1128 L=1,NUMP+2
1128   PCH(K,L)=0 

	ITYP=-1
C   TYPE 'FILE NAME', TEMPO FACTOR(0=1), AMPL.FACT(0=1),
C   SECONDS TO BE OMITTED, DUR AT CUTOFF.
	JED=-1
2112	TYPE 8002
1112	ACCEPT 77732,JNP
	JFM(4)='5F)'
	JFM(1)='   (A'
C   FOR FREE 'A' FORMAT
	CALL FMT(JFM,JNP,MLX)
	REREAD JFM,K,TF,AMPFAC,OP1,DURX
	CALL LO2UP(K)
C  JFM IS THE CURRENT FORMAT STATEMENT
999	IF(K.NE.'EDIT')GO TO 3112
	JED=0
	GO TO 2112
C  'E(DIT)' GOES TO EDIT MODE
3112	IF(TF.EQ.0)TF=1.
	IF(AMPFAC.EQ.0)AMPFAC=1.
21122	IF(K.NE.'TYPE')GO TO 128
	ITYP=0
	DATA FINM/30H(' TYPE OUTPUT FILE NAME'/)   /
	IFLNM='TYPED'
	CALL OFILE(21,IFLNM)
	GO TO 3127
8001	FORMAT(A5,5F)
77732	FORMAT(80A1)
300	FORMAT(I,3F)
128	IF(K.EQ.'INFO')GO TO 1280
	IF(K.EQ.'HELP')GO TO 1280
	IF(K.NE.'?')GO TO 3128
1280	TYPE 8002
	TYPE 1113
	TYPE 118
	TYPE 1114
	TYPE 8002
	GO TO 1112
118	FORMAT(' TO DSK=1,11   TTY=2,22   BOTH=0,33   LPT=4'/)
8002	FORMAT(' TYPE FILE NAME--  '$)
1113	FORMAT(' YOU MAY TYPE:  NAME  TEMPO-FAC  AMPFAC  OMIT"  DUR"'//)
1114	FORMAT('    FOR THE ABOVE YOU MAY TYPE UP TO 3 NUMBERS: N1 N2 N3'//
	1' N1 = 1 WRITES DATA ON DSK,  =2 WRITES ONLY ON SCREEN,'/
	1'    = 0 WRITES ON DSK AND SCREEN.'/
	1'    = 11,22,33 ARE THE SAME AS 1,2,0 BUT INPUT LIST IS NOT
	1 WRITTEN ON SCREEN.'/
	1/' N2 = RAN NUM INITIALIZATION.       N3 = DO ONLY INST. #N'/
	1/' ALSO FOR N1:  N1=5(OR 55)=DURS ONLY (FOR PROOFING)
	1, =6(OR 66)=DEBUG V ARRAY'//
	1 3X' UP TO 99 PARAMETERS AND 27 INSTRUMENTS ARE AVAILABLE'/)

3128	IF(K.EQ.IBLA)K=IFLNM
	CALL IFILE(23,K)
	IFLNM=K
	READ(23,300)LN,IXIN
C  CHECK FOR LINE NUMBERS ONLY.
3000	REWIND 23
	CALL IFILE(23,IFLNM)

3127	ISLAC=IFLNM
C  NOW USES MY FORNAM SUBROUTINE TO  PUT EXTENSION .SCR ON OUTPUT
5127	TYPE 118
	IF(DURX.EQ.0)DURX=19999.
	IXIN=1
	INONLY=-1
	SOS=-1.
	ACCEPT 300,MX,X,Z
	IF(MX.NE.99)GO TO 6127
	TYPE FINM
	ACCEPT 8001,ISLAC
	CALL LO2UP(ISLAC)
	GO TO 5127
6127	IF(Z.NE.0)INONLY=Z
	IF(X.NE.0)IXIN=X
	IF(MX.LT.10)GO TO 8127
	MX=MX/10
	IF(MX.EQ.3)MX=0
	SOS=0
C MX=10,11,ETC.,22,ETC.(INSTEAD OF 1,2) SUPPRESSES INPUT LISTING.
8127	JOUT=5
C  5=OUTPUT TO TTY
	MZ=0
	GO TO(110,210,310,410,510,610)MX
C 0=DSK,TTY  1=DSK  2=TTY  3=0  4=LPT  5=TTY  6=TTY
310	MZ=-1
110	CALL FORNAM(ISLAC,'SCR')
	MX=-1  
	CALL READIT
CC410	JOUT=22
410	JOUT=3 
C DIRECT TO LPT AT COLGATE 6/74
210	MZ=-1
510	CALL READIT
610	MZ=-6
	CALL READIT
      END

	SUBROUTINE LO2UP(J)
C CONVERTS ALL LOWER CASE IN WORD J TO UPPER CASE.
	J=J.AND..NOT.((J/2).AND."201004020100)
	END